module DataUpdate where
import Data.Map (Map)
import qualified Data.Map as Map
import qualified Data.Set as Set
import Data.List (intersperse)

---------------------------------------------------------------------------
------------------- DValMap -----------------------------------------------
---------------------------------------------------------------------------
data DValMap k a = DValMap (Map k a) a
    deriving (Eq)

get :: (Ord k) => (DValMap k v) -> k -> v
get (DValMap theMap value) k = 
    Map.findWithDefault value k theMap

(#) :: (Ord k) => (DValMap k v) -> k -> v
(#) = get
infixl 9 #

set :: Ord k => Eq v => 
    (DValMap k v) -> k -> v -> (DValMap k v) 
set (DValMap theMap value) k v  
    | value == v && Map.notMember k theMap = 
        DValMap theMap value
    | value == v && Map.member k theMap = 
        DValMap (Map.delete k theMap) value
    | otherwise = 
        DValMap (Map.insert k v theMap) value
    
(\\) dict (k, v) = set dict k v
infixl 8 \\

delete :: Ord k => k -> (DValMap k v) -> (DValMap k v)
delete k (DValMap theMap value) = DValMap (Map.delete k theMap) value  
    
empty :: v -> DValMap k v
empty value = DValMap (Map.empty) value

isNull :: DValMap k v -> Bool
isNull (DValMap theMap _) = Map.null theMap

getDefaultValue (DValMap theMap value) = value

foldWithKey :: Ord k => (k->v->a->a)->a->DValMap k v->a
foldWithKey func initValue (DValMap theMap value) = 
    (Map.foldWithKey func initValue theMap) 

unionWithKey :: Ord k => Eq c => (k -> a -> b -> c) -> c -> DValMap k a -> DValMap k b  -> DValMap k c
unionWithKey f dv (DValMap m1 dv1) (DValMap m2 dv2) = Set.fold  f' (empty dv) (Set.union (Map.keysSet m1) (Map.keysSet m2))
    where
    f' k d = d \\ (k, (f k ((DValMap m1 dv1)#k) ((DValMap m2 dv2)#k)))

mapWithKey :: Ord k => Eq a => Eq b => 
    (k->a->b)->b->DValMap k a->DValMap k b
mapWithKey func dVal aMap = 
    foldWithKey f (empty dVal) aMap
    where 
    f k v d = d \\ (k, func k v)

fromList :: Ord k => Eq a => [(k,a)] -> a -> DValMap k a
fromList list defaultValue = fromList' list (empty defaultValue)
fromList' ((k, a):xs) dict = fromList' xs (dict \\ (k ,a))
fromList' [] dict = dict

toList :: DValMap k a -> [(k, a)]
toList (DValMap theMap value) = Map.toList theMap


showMap pointer theMap = ((foldl (.) (showString "{").
        intersperse (showString ", ").
        map (\(k, v)-> shows k.showString pointer.shows v).
        toList) theMap).showString "}"

instance (Show v, Show k, Ord k) =>  Show (DValMap k v) where
    showsPrec _ theMap = showMap "->" theMap

keysSet (DValMap theMap value) = Map.keysSet theMap    

--instance (Read v, Read k, Ord k) => Read (DValMap k v) where
    


---------------------------------------------------------------------------
------------------- Values -----------------------------------------------
---------------------------------------------------------------------------

data Prim = Int Int | String String | Null
    deriving (Eq, Ord)
type Dict = DValMap Prim Value
data Value = Prim Prim | Dict Dict 
    deriving (Eq)
    

emptyDict :: Dict    
emptyDict = empty (Prim Null)


emptyDictValue :: Value    
emptyDictValue = Dict (empty (Prim Null))

instance Show Prim where
    showsPrec _ (Int v) = shows v
    showsPrec _ (String v) = shows v
    showsPrec _ Null = showString "null"
     


instance Show Value where
    showsPrec d (Prim v) = shows v
    showsPrec d (Dict dict) = showMap "=" dict

--getDict :: Dict->Prim->Value
--getDict dict k  = getDict' (Map.lookup k dict)
--getDict' Nothing = Null
--getDict' (Just a) = a
--
--setDict :: Dict -> Prim -> Value -> Dict 
--setDict dict k Null = dict
--setDict dict k v = Map.insert k v dict

---------------------------------------------------------------------------
------------------- Updates -----------------------------------------------
---------------------------------------------------------------------------


type PUpdate = Prim
type DUpdate = DValMap Prim Update
data Update = PUpdate PUpdate | DUpdate DUpdate | Void 
    deriving (Eq)

instance Show Update where
    showsPrec _ (PUpdate v) = shows v
    showsPrec _ (DUpdate dict) = showMap "->" dict
    showsPrec _ Void = showString "void"

    
emptyDUpdate = empty Void

apply :: Update -> Value -> Value
apply (PUpdate new) old = Prim new
apply (DUpdate du) (Dict dict) = Dict $ unionWithKey (\k u v->apply u v) (getDefaultValue dict) du dict
apply (DUpdate du) _ = apply (DUpdate du) emptyDictValue
apply Void a = a


effective :: Update -> Value -> Update
effective (PUpdate new) (Prim old) 
    | new /= old = PUpdate new
    | otherwise = Void
effective (PUpdate new) _ = PUpdate new 
effective (DUpdate du) (Dict dict) = if dupdate == emptyDUpdate then Void else DUpdate dupdate  
     where
        dupdate = mapWithKey (\k u->effective u (dict#k)) (getDefaultValue du) du
effective (DUpdate du) _ = DUpdate du
effective Void _ = Void


--getDUpdate :: DUpdate->Prim->Update
--getDUpdate dupdate k  = getDUpdate' (Map.lookup k dupdate)
--getDUpdate' Nothing = Void
--getDUpdate' (Just a) = a
--
--setDUpdate :: DUpdate -> Prim -> Update -> DUpdate 
--setDUpdate dict k Void = dict
--setDUpdate dict k v = Map.insert k v dict

(<*) :: Update -> Update -> Update
infixl 4 <*
a <* Void = a
_ <* (PUpdate b) = PUpdate b
(DUpdate a) <* (DUpdate b) = DUpdate (unionWithKey (\_ au bu -> au <* bu) (getDefaultValue b) a b) 
_ <* (DUpdate b) = DUpdate b

compatible u1 u2 = (u1 <* u2) == (u2 <* u1)

unionUpdate :: Update->Update->Maybe Update
unionUpdate u1 u2 | compatible u1 u2 = Just (u1 <* u2)
                  | otherwise = Nothing


findUpdate :: Value -> Value -> Update
findUpdate (Prim b) (Prim a) | a == b = Void
findUpdate _ (Prim a) = PUpdate a
findUpdate (Dict d1) (Dict d2) = if result == DUpdate emptyDUpdate then Void else result 
    where
        result = findUpdate' (Dict d1) (Dict d2)
findUpdate _ (Dict d2) = findUpdate' emptyDictValue (Dict d2)
findUpdate' (Dict d1) (Dict d2) = DUpdate (unionWithKey (\k v1 v2 -> findUpdate v1 v2) Void d1 d2) 
